home *** CD-ROM | disk | FTP | other *** search
/ MACD 5 / MACD 5.bin / workbench / blankery / blitzblank / sources / bb.pyro < prev    next >
Text File  |  1993-09-17  |  8KB  |  384 lines
  1. ;BB.Pyro - Blanker-module for BlitzBlank
  2. ;Copyright 1993 by Thomas Boerkel
  3.  
  4. CloseEd
  5.  
  6. NEWTYPE.spritedata
  7. a.w
  8. b
  9. c
  10. d
  11. e
  12. f
  13. End NEWTYPE
  14.  
  15. NEWTYPE.tags
  16. a.l
  17. b
  18. c
  19. d
  20. e
  21. f
  22. End NEWTYPE
  23.  
  24. DEFTYPE.spritedata *sprdata
  25. DEFTYPE.Screen *myscreen,*myscreen2
  26. DEFTYPE.NewScreen newscreen
  27. DEFTYPE.Window *mywindow
  28. DEFTYPE.NewWindow newwindow
  29. DEFTYPE.Message *msg
  30. DEFTYPE.MsgPort *port
  31. DEFTYPE.tags tags
  32.  
  33. Statement stringborder{x,y,w,h}
  34. Wline x+1,y+h+2,x+1,y,x+w+8,y,1
  35. Wline x+w+10,y-1,x+w+10,y+h+4,x-1,y+h+4,1
  36. Wline x,y+h+3,x,y,1
  37. Wline x+w+11,y-1,x+w+11,y+h+4,1
  38. Wline x-1,y+h+3,x-1,y-1,x+w+10,y-1,2
  39. Wline x+w+9,y,x+w+9,y+h+3,x+1,y+h+3,2
  40. Wline x-2,y+h+4,x-2,y-1,2
  41. Wline x+w+8,y+1,x+w+8,y+h+2,2
  42. End Statement
  43.  
  44.  
  45. Select Par$(1)
  46.  
  47.   Case "BLANK"
  48.  
  49.     name$="BB.BlankModule"+Chr$(0)
  50.     *port=CreateMsgPort_()
  51.     *port\mp_Node\ln_Name=&name$
  52.     *port\mp_Node\ln_Pri=1
  53.     AddPort_ *port
  54.     n=0
  55.     Gosub readconfig
  56.     SetTaskPri_ FindTask_(0),Val(Par$(8))
  57.     Dim xf(n+1,9)
  58.     Dim yf(n+1,9)
  59.     Dim xk(2,n+1,9)
  60.     Dim yk(2,n+1,9)
  61.     Dim wg(9)
  62.  
  63.     Dim va(n+1)
  64.     Dim xa(n+1)
  65.     Dim t(n+1)
  66.     Dim t2(n+1)
  67.     Dim et(n+1)
  68.     Dim sinwb(n+1)
  69.     Dim coswb(n+1)
  70.     Dim x(2,n+1)
  71.     Dim y(2,n+1)
  72.     Dim f(n+1)
  73.     Dim c(n+1)
  74.     *sprdata=AllocMem_(SizeOf.spritedata,#MEMF_CHIP|#MEMF_CLEAR)
  75.     newwindow\LeftEdge=0,0,1,1
  76.     newwindow\Flags=#WFLG_ACTIVATE
  77.     newwindow\FirstGadget=0,0,0,0,0,-1,-1,-1,-1,#WBENCHSCREEN
  78.  
  79.     *mywindow=OpenWindow_(newwindow)
  80.  
  81.     VWait
  82.     SetPointer_ *mywindow,*sprdata,0,0,0,0
  83.  
  84.  
  85.  
  86.     width.l=Val(Par$(2))
  87.     height.l=Val(Par$(3))
  88.  
  89.     mode.l=Val(Par$(4))
  90.     monitor.l=Val(Par$(5))
  91.  
  92.     depth.w=Val(Par$(6))
  93.     colors.w=2^depth
  94.  
  95.     title1$="BB.Pyro0"+Chr$(0)
  96.     newscreen\LeftEdge=0,0,width,height,depth
  97.     newscreen\ViewModes=0,#CUSTOMSCREEN|#SCREENBEHIND,0,&title1$
  98.     tags\a=#SA_DisplayID
  99.     tags\b=$10000*monitor+mode
  100.     tags\c=0
  101.     *myscreen=OpenScreenTagList_(newscreen,tags)
  102.     If db
  103.       title2$="BB.Pyro1"+Chr$(0)
  104.       newscreen\ViewModes=0,#CUSTOMSCREEN|#SCREENBEHIND,0,&title2$
  105.       *myscreen2=OpenScreenTagList_(newscreen,tags)
  106.     EndIf
  107.  
  108.     If *myscreen AND (db=0 OR *myscreen2)
  109.       For i=0 To db
  110.         FindScreen i,"BB.Pyro"+Str$(i)
  111.         ScreensBitMap i,i
  112.         RGB 0,0,0,0
  113.         RGB 1,15,15,0
  114.         If colors>2
  115.           RGB 2,0,10,15
  116.           RGB 3,15,7,0
  117.           If colors>4
  118.             RGB 4,0,15,0
  119.             RGB 5,15,3,8
  120.             RGB 6,15,5,15
  121.             RGB 7,5,15,8
  122.             If colors>8
  123.               RGB 8,15,0,0
  124.               RGB 9,0,15,0
  125.               RGB 10,0,0,15
  126.               RGB 11,0,7,15
  127.               RGB 12,8,15,3
  128.               RGB 13,15,10,0
  129.               RGB 14,7,0,15
  130.               RGB 15,3,8,15
  131.             EndIf
  132.           EndIf
  133.         EndIf
  134.         Boxf 0,0,width-1,height-1,0
  135.       Next i
  136.  
  137.       If db=0
  138.         ScreenToFront_ *myscreen
  139.       EndIf
  140.  
  141.       g=0.1
  142.       vamax=Sqr(2*(height-1)*g)/Sin(90*Pi/180)
  143.       ve=vamax/4
  144.  
  145.       For i=1 To 6
  146.         wg(i)=Pi/3*i
  147.       Next i
  148.  
  149.       Dim si.q(631)
  150.       Dim co.q(631)
  151.  
  152.       For i=0 To 630
  153.         f=i/100
  154.         si(i)=Sin(f)
  155.         co(i)=Cos(f)
  156.       Next i
  157.  
  158.  
  159.  
  160.       Repeat
  161.         If db
  162.           Use BitMap s
  163.         Else
  164.           VWait
  165.         EndIf
  166.         For j=1 To n
  167.           If f(j)=0
  168.             f(j)=1
  169.             wa=Rnd(40)+70
  170.             wb=wa*Pi/180
  171.  
  172.             sinwb(j)=si(Int(wb*100))
  173.             coswb(j)=co(Int(wb*100))
  174.             xa(j)=width/2
  175.             va(j)=Rnd(vamax/3)+vamax/3*2
  176.  
  177.             et(j)=Int(Rnd(40)+(va(j)*sinwb(j))/g)
  178.             c(j)=Rnd(colors-1)+1
  179.           Else
  180.             If t(j)<et(j)
  181.               Plot x(s,j),y(s,j),0
  182.               x(s,j)=xa(j)+va(j)*coswb(j)*t(j)
  183.               y(s,j)=height-1-va(j)*sinwb(j)*t(j)+0.5*g*t(j)*t(j)
  184.               Plot x(s,j),y(s,j),c(j)
  185.               t(j)+.5
  186.             EndIf
  187.  
  188.             If t(j)=et(j)+1 AND t2(j)<15
  189.               For i=1 To 6
  190.                 Plot xk(s,j,i),yk(s,j,i),0:Plot xk(s,j,i)+1,yk(s,j,i),0
  191.                 xk(s,j,i)=x(0,j)+xf(j,i)*t2(j)
  192.                 yk(s,j,i)=y(0,j)+yf(j,i)*t2(j)+0.5*g*t2(j)*t2(j)
  193.                 Plot xk(s,j,i),yk(s,j,i),c(j):Plot xk(s,j,i)+1,yk(s,j,i),c(j)
  194.               Next i
  195.               t2(j)+.5
  196.             EndIf
  197.  
  198.             If t(j)=et(j)
  199.               Plot x(s,j),y(s,j),0
  200.               If db
  201.                 Use BitMap 1-s
  202.                 Plot x(1-s,j),y(1-s,j),0
  203.                 Use BitMap s
  204.               EndIf
  205.               For i=1 To 6
  206.  
  207.                 xf(j,i)=va(j)*coswb(j)+ve*co(Int(wg(i)*100))
  208.                 yf(j,i)=ve*si(Int(wg(i)*100))-va(j)*sinwb(j)+g*t(j)
  209.                 xk(s,j,i)=0
  210.                 yk(s,j,i)=0
  211.                 If db
  212.                   xk(1-s,j,i)=0
  213.                   yk(1-s,j,i)=0
  214.                 EndIf
  215.               Next i
  216.               t(j)+1
  217.             EndIf
  218.  
  219.  
  220.  
  221.             If t2(j)>15
  222.               For i=1 To 6
  223.                 Plot xk(s,j,i),yk(s,j,i),0:Plot xk(s,j,i)+1,yk(s,j,i),0
  224.               Next i
  225.               If db
  226.                 Use BitMap 1-s
  227.                 For i=1 To 6
  228.                   Plot xk(1-s,j,i),yk(1-s,j,i),0:Plot xk(1-s,j,i)+1,yk(1-s,j,i),0
  229.                 Next i
  230.                 Use BitMap s
  231.               EndIf
  232.  
  233.               t2(j)=0
  234.               t(j)=0
  235.               et(j)=0
  236.               f(j)=0
  237.             EndIf
  238.  
  239.             If t2(j)=15
  240.               t2(j)=16
  241.             EndIf
  242.           EndIf
  243.         Next j
  244.         *msg=GetMsg_(*port)
  245.         If db
  246.           ShowScreen s
  247.           s=1-s
  248.         EndIf
  249.  
  250.       Until *msg
  251.       CloseScreen_ *myscreen
  252.       If db
  253.         CloseScreen_ *myscreen2
  254.       EndIf
  255.     EndIf
  256.     ClearPointer_ *mywindow
  257.     CloseWindow_ *mywindow
  258.     FreeMem_ *sprdata,SizeOf.spritedata
  259.     RemPort_ *port
  260.     DeleteMsgPort_ *port
  261.  
  262.  
  263.  
  264.   Case "INFO"
  265.     title$="Pyro"+Chr$(0)
  266.     reqtext$="Pyro - Module for BlitzBlank"+Chr$(10)
  267.     reqtext$+Chr$(169)+" 1993 by Thomas Brkel + Wolfgang Brkel"+Chr$(10)+Chr$(10)
  268.     reqtext$+"You see fireworks on a black screen."+Chr$(10)
  269.     reqtext$+"Pyro is not compatible with graphic-cards,"+Chr$(10)
  270.     reqtext$+"use Pyro_GC instead."+Chr$(10)+Chr$(10)
  271.     reqtext$+"Choose the number of flares and the doublebuffering"+Chr$(10)
  272.     reqtext$+"in the config-window."+Chr$(0)
  273.     gadget$="OK"+Chr$(0)
  274.     easy.EasyStruct\es_StructSize=SizeOf.EasyStruct
  275.     easy\es_Title=&title$
  276.     easy\es_TextFormat=&reqtext$
  277.     easy\es_GadgetFormat=&gadget$
  278.     EasyRequestArgs_ 0,easy,0,0
  279.  
  280.   Case "CONFIG"
  281.     *myscreen=LockPubScreen_(0)
  282.     width=*myscreen\Width
  283.     height=*myscreen\Height
  284.     font=*myscreen\Font\ta_YSize
  285.     Gosub readconfig
  286.     WbToScreen 0
  287.  
  288.  
  289.     BorderPens 0,0
  290.     StringGadget 0,100,45,0,0,4,30
  291.     BorderPens 2,1
  292.     TextGadget 0,37,20,1,1,"Doublebuffer"
  293.     If db
  294.       Toggle 0,1,On
  295.     EndIf
  296.     Window 0,width/2-90,height/2-35,180,70,$100e,"Pyro",1,2,0
  297.     stringborder{100,45,30,8}
  298.     WColour 2
  299.     WLocate 32,44-font
  300.     Print "Flares:"
  301.     WLocate 32,44-font+8
  302.     Print "(1-50)"
  303.     SetString 0,0,Str$(n)
  304.     ActivateString 0,0
  305.     Repeat
  306.       ev=WaitEvent
  307.     Until ev=$200 OR (ev=$40 AND GadgetHit=0)
  308.     n=Val(StringText$(0,0))
  309.     If GadgetStatus(0,1)
  310.       db=1
  311.     Else
  312.       db=0
  313.     EndIf
  314.     Free Window 0
  315.     Gosub writeconfig
  316.     UnlockPubScreen_ 0,*myscreen
  317.  
  318. End Select
  319.  
  320. End
  321.  
  322. .readconfig
  323. path$=Par$(9)
  324. For i=10 To NumPars
  325.   path$=path$+" "+Par$(i)
  326. Next i
  327. If ReadFile(0,path$+"BB.Modules.config")
  328.   FileInput 0
  329.   While NOT Eof(0)
  330.     If Edit$(100)="*** Pyro ***"
  331.       n=Edit(5)
  332.       db=Edit(5)
  333.     EndIf
  334.   Wend
  335.   DefaultInput
  336.   CloseFile 0
  337. EndIf
  338. Gosub checkval
  339. Return
  340.  
  341.  
  342. .writeconfig
  343. Gosub checkval
  344. If ReadFile(0,path$+"BB.Modules.config")
  345.   If WriteFile(1,path$+"BB.Modules.temp")
  346.     FileInput 0
  347.     FileOutput 1
  348.     While NOT Eof(0)
  349.       f$=Edit$(100)
  350.       If f$="*** Pyro ***"
  351.         Repeat
  352.           f2$=Edit$(100)
  353.         Until Eof(0) OR Left$(f2$,3)="***"
  354.         If NOT Eof(0) Then NPrint f2$
  355.       Else
  356.         NPrint f$
  357.       EndIf
  358.     Wend
  359.     CloseFile 1
  360.   EndIf
  361.   CloseFile 0
  362. EndIf
  363. KillFile path$+"BB.Modules.config"
  364. f$=path$+"BB.Modules.temp"+Chr$(0)
  365. f2$=path$+"BB.Modules.config"+Chr$(0)
  366. Rename_ &f$,&f2$
  367. If OpenFile(0,path$+"BB.Modules.config")
  368.   FileOutput 0
  369.   FileSeek 0,Lof(0)
  370.   NPrint "*** Pyro ***"
  371.   NPrint n
  372.   NPrint db
  373.   CloseFile 0
  374. EndIf
  375. Return
  376.  
  377. .checkval
  378. If n<1 Then n=10
  379. If n>50 Then n=10
  380. If db<0 Then db=0
  381. If db>1 Then db=1
  382. Return
  383.  
  384.